home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / PLX13.ARJ / FONTS.PAS next >
Pascal/Delphi Source File  |  1991-10-11  |  6KB  |  213 lines

  1. {FONTS - Extensions to ObjectWindows Copyright (C) Doug Overmyer 10/1/91}
  2. {This unit puts an OO face on enum. fonts for a given DC. Stores info in
  3.     mem structure and facilitates retrieval}
  4. unit Fonts;
  5.  
  6.  
  7. {******************************************************************}
  8. { I N T E R F A C E                                                }
  9. {******************************************************************}
  10. interface
  11. uses WinTypes, WinProcs, WinDos, Strings, WObjects,StdDlgs,
  12.       WFPlus,WOPlus;
  13.  
  14. type
  15.     PIntObj = ^TIntObj;
  16.   TIntObj = object(TObject)
  17.       Int:Integer;
  18.     constructor Init(NewInt:Integer);
  19.     destructor Done;virtual;
  20.     end;
  21.  
  22.  
  23. type                          {convert TLogFont records to objects}
  24. PFontItem = ^TFontItem;
  25. TFontItem = object(TObject)
  26.     LogFont:TLogFont;
  27.   FontType:Integer;
  28.   Sizes:PCollection;
  29.   constructor Init(NewItem:TLogFont;NewType:Integer);
  30.   destructor Done;virtual;
  31. end;
  32.  
  33. PFontCollection = ^TFontCollection;   {Collection of printer TLOGFont recs}
  34. TFontCollection = object(TSortedCollection)
  35.     function KeyOf(Item:Pointer):Pointer;virtual;
  36.   function Compare(Key1,Key2:Pointer):Integer;virtual;
  37.   function GetCount:Integer;virtual;
  38. end;
  39.  
  40. type PFonts = ^TFonts;
  41. TFonts = object
  42.     LogPixlX,LogPixlY:Integer;
  43.   constructor Init;
  44.   destructor Done;virtual;
  45.   procedure ReInit;virtual;
  46.   procedure Enumerate(TheDC:hDC);virtual;
  47.   function At(Index:Integer):pointer;virtual;
  48.   function Count:Integer;virtual;
  49.   function LogPixX:Integer;virtual;
  50.   function LogPixY:Integer;virtual;
  51. end;
  52.  
  53.  
  54. {********************************************************************}
  55. {I M P L E M E N T A T I O N                                         }
  56. {********************************************************************}
  57. implementation
  58.  
  59. {********************************************************************}
  60. {G L O B A L  V A R I A B L E S                                      }
  61. {********************************************************************}
  62. var
  63.   Faces:PFontCollection; {collection of PFontItem for call-back func}
  64.  
  65. {***********************************************************************}
  66. constructor TIntObj.Init(NewInt:Integer);
  67. begin
  68.     Int := NewInt;
  69. end;
  70.  
  71. destructor TIntObj.Done;
  72. begin
  73.  
  74. end;
  75. {********************************************************************}
  76. constructor TFontItem.Init(NewItem:TLogFont;NewType:Integer);
  77. begin
  78.     LogFont := NewItem;
  79.   FontType := NewType;
  80.   Sizes := New(PCollection,Init(10,10));
  81. end;
  82.  
  83. destructor TFontItem.Done;
  84. begin
  85.     Dispose(Sizes,Done);
  86. end;
  87.  
  88. {*********************************************************************}
  89. function TFontCollection.KeyOf(Item:Pointer):Pointer;
  90. var
  91.     Ptr :PChar;
  92. begin
  93.     Ptr := PFontItem(Item)^.LogFont.lfFaceName;
  94.     KeyOf := Ptr;
  95. end;
  96.  
  97.  
  98. function TFontCollection.Compare(Key1,Key2:Pointer):Integer;
  99. begin
  100.     Compare := StrIComp(PChar(Key1),PChar(Key2));
  101. end;
  102.  
  103. function TFontCollection.GetCount:Integer;
  104. begin
  105.     GetCount := Count;
  106. end;
  107. {******************************************************************}
  108. constructor TFonts.Init;
  109. begin
  110.     Faces := New(PFontCollection,Init(100,100));
  111.   Faces^.Duplicates := False;
  112.   LogPixlX := 0;
  113.   LogPixlY := 0;
  114. end;
  115.  
  116. destructor TFonts.Done;
  117. begin
  118.     Dispose(Faces,Done);
  119. end;
  120.  
  121. procedure TFonts.ReInit;
  122. begin
  123.     Dispose(Faces,Done);
  124.     Faces := New(PFontCollection,Init(100,100));
  125.   Faces^.Duplicates := False;
  126.   LogPixlX := 0;
  127.   LogPixlY := 0;
  128. end;
  129.  
  130.  
  131. function EnumerateFace(var LogFont: TLogFont; TextMetric: PTextMetric;
  132.       FontType: Integer; Data: PChar): Integer; export;
  133.  function DupF(Item:PFontItem):Boolean;far;
  134.      begin
  135.   DupF := (StrIComp(Item^.LogFont.lfFaceName, LogFont.lfFacename)= 0);
  136.   end;
  137. var
  138.   Result:PFontItem;
  139. begin
  140.    Result := Faces^.FirstThat(@DupF);
  141.    if Result = nil then Faces^.Insert(New(PFontItem,Init(LogFont,FontType)));
  142.    EnumerateFace := 1;
  143. end;
  144.  
  145.  
  146. function EnumerateSize(var LogFont: TLogFont; TextMetric: PTextMetric;
  147.           FontType: Integer; Indx: PChar): Integer; export;
  148.  function DupS(Item:PIntObj):Boolean;far;
  149.       begin
  150.        DupS := (Item^.Int = LogFont.lfHeight);
  151.    end;
  152. var
  153.   Result :PIntObj;
  154.   FI:PFontItem;
  155.   Indxx :Integer;
  156.   Error:Integer;
  157. begin
  158.     Val(Indx,Indxx,Error);
  159.   FI := Faces^.At(Indxx);
  160.   Result := FI^.Sizes^.FirstThat(@DupS);
  161.   if Result = nil then Fi^.Sizes^.AtInsert(0,(New(PIntObj,Init(LogFont.lfHeight)))) ;
  162.     EnumerateSize := 1;
  163. end;
  164.  
  165.  
  166.  
  167. procedure TFonts.Enumerate(TheDC:hDC);
  168. var
  169.   EnumProc: TFarProc;
  170.   Indx:Integer;
  171.   pIndx:PChar;
  172.   szIndx:Array[0..25] of Char;
  173.   FontItem :PFontItem;
  174.  
  175. begin
  176.     pIndx := @szIndx;
  177.     StrCopy(szIndx,'');
  178.   EnumProc := MakeProcInstance(@EnumerateFace, HInstance);
  179.   EnumFonts(TheDC, nil, EnumProc,nil);
  180.   EnumProc := MakeProcInstance(@EnumerateSize, HInstance);
  181.   for Indx := 0 to Faces^.Count -1 do
  182.       begin
  183.     Str(Indx,szIndx);
  184.     FontItem := Faces^.At(Indx);
  185.     EnumFonts(TheDC, FontItem^.LogFont.lfFaceName,
  186.         EnumProc,pIndx);
  187.     end;
  188.   LogPixlX := GetDeviceCaps(TheDC,LogPixelsX);
  189.   LogPixlY := GetDeviceCaps(TheDC,LogPixelsY);
  190. end;
  191.  
  192. function TFonts.At(Index:Integer):Pointer;
  193. begin
  194.     At := Faces^.At(Index);
  195. end;
  196.  
  197. function TFonts.Count:Integer;
  198. begin
  199.     Count := Faces^.Count;
  200. end;
  201.  
  202. function TFonts.LogPixX:Integer;
  203. begin
  204.     LogPixX := LogPixlX;
  205. end;
  206.  
  207. function TFonts.LogPixY:Integer;
  208. begin
  209.     LogPixY := LogPixlY;
  210. end;
  211. {******************************************************************}
  212. end.
  213.